perm filename LOOP.FAI[P11,LCS] blob
sn#590687 filedate 1981-05-28 generic text, type T, neo UTF8
00100 TITLE LOOPX
00200 ENTRY DPYNEW,FSCAN,BOX,dpydo
00300
00400 EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL
00500 EXTERNAL RRJJ,STF,ALF,POSI,RMOD,RINP,SIZ,LIMIT,IDEV,DDCLR
00600 EXTERNAL RHORZ,SETCUR,DPYSET,DPYBRT,SETPOG,ALINE,DPTR,DPYX
00700 EXTERNAL LOOP
00800 A←6 ↔K←7↔ R←12↔ L←13
00900 ;**** AC'S 0,1,2,3,5 ARE USED IN 'PLACE' & 'FINDIT'!!
01000
01100 DPYNEW: 0 ; SUBROUTINE DPYNEW
01200 JSA 16,ACCPOG ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
01300 JUMP [1] ; CALL ACCPOG(1)
01400 MOVE 2,DPY+=4001 ; IF(IGO.GT.0)RETURN
01500 JUMPG 2,DB ; CALL DPYOUT(1)
01600 JSA 16,DPYDO ; END
01700 JUMP [1]
01800 DB: JRA 16,(16)
01900
02000 FSCAN: 0
02100 INCHRW
02200 MOVE 2,[ASCII/ /]
02300 MOVEM 2,ALF
02400 MOVE 2,[XWD ALF,ALF+1]
02500 BLT 2,ALF+=71 ; CLEANS OUT INP ARRAY
02600 CAIN ";"
02700 JRA 16,(16)
02800 CAIN ":"
02900 JRA 16,1(16)
03000 CAIN "("
03100 JRA 16,2(16)
03200 CAIN ")"
03300 JRA 16,3(16)
03400 CAIN "/"
03500 JRA 16,4(16)
03600 CAIN "*"
03700 JRA 16,5(16)
03800 CAIN "X"
03900 JRA 16,6(16)
04000 CAIN "C"
04100 JRA 16,7(16)
04200 JRA 16,8(16)
04300
04400
04500 BOX: 0 ;CALL BOX(I,R) SEE PLTSRT.F4 FOR FORTR. VERSION
04600 MOVE IDEV
04700 CAIE 5
04800 JRST BX4-3 ;UPDATE IOLD JRA 16,2(16) ;IF(IDEV.NE.5)RETURN
04900 MOVE 14,@(16) ; I IS IN 14
05000 JUMPL 14,BX4
05100 KIFIX 13,@1(16) ;K=R ;MOVE 13,@1(16) ; GET R
05200 JSA 16,AMOD
05300 JUMP XRN+3(14) ; GET REAL P4
05400 [100.0]
05500 CAMGE [-20.0] ;IF(P4.LT.-20)P4=P4+100
05600 FADR [100.0] ; FOR P4=-95 ETC.
05700 CAML [80.0] ;IF(P4.GE.80)P4=P4-100
05800 FSBR [100.0] ; CATCHES NEG. MINIS, ETC.
05900 FMPR [7.0]
06000 FMPR STF(13) ;*STAFF FACTOR
06100 FADR POSI(13) ; + STAFF VERT. POS.
06200 FSBR [40.0] ; SHIFT CURSOR DOWN A BIT.
06300 FMPR SIZ
06400 KIFIX 13,0
06500 SUB 13,SIZ+2 ;13=K
06600 JSA 16,RHORZ ; GET HORIZ. POS.
06700 JUMP XRN+2(14)
06800 FMPR SIZ ;SIZ IS FOR ZOOMED IMAGES
06900 KIFIX 12,0 ;MOVE 12, ; 12=L
07000 SUB 12,SIZ+1
07100 CAIL 12,=550 ; CHECK IF OUT OF BOUNDS OF CRT
07200 MOVEI 12,=511
07300 CAMG 12,[-=550]
07400 MOVE 12,[-=511]
07500 DDCHK: MOVNI 2,1
07600 GETLIN 2 ;0=IT IS A DD
07700 TLNN 2,20000 ; -1=NOT DD
07800 JRST NOTDD
07900 ;; JSA 16,DDCLR
08000 ;; JSA 16,DPYSET
08100 ;; [3] ;MAKE A CURSOR ON DATADISC
08200 ;; RINP
08300 ;; [=100]
08400 MOVE 14,DPY+1 ;GET DPY WDCNT
08500 MOVE 12
08600 SUBI 20
08700 MOVEM X1#
08800 ADDI 40
08900 MOVEM X2#
09000 MOVE 13
09100 SUBI 20
09200 MOVEM Y1#
09300 ADDI 40
09400 MOVEM Y2#
09500 ;; JSA 16,SETPOG
09600 ;; [3]
09700 JSA 16,ALINE
09800 JUMP X1
09900 JUMP Y1
10000 JUMP X2
10100 JUMP Y2
10200 JSA 16,ALINE
10300 JUMP X1
10400 JUMP Y2
10500 JUMP X2
10600 JUMP Y1
10700 ;; JSA 16,DPYDO
10800 ;; [3]
10900 ;; JSA 16,SETPOG
11000 ;; [1]
11100 JSA 16,DPYDO
11200 [1]
11300 MOVEM 14,DPY+1 ;PUT BACK DPY WDCNT.
11400 JRST BX4-3 ;JRA 16,2(16) ;MAKE AN X ON THE DATA DISC
11500 NOTDD: JSA 16,SETCUR
11600 12
11700 13
11800 [0]
11900 MOVE DL ;IOLD=X22 FOR TYPING "I <CR>" TO GET LAST EDIT BACK.
12000 MOVEM DL+4
12100 JRA 16,2(16) ; THE CURSOR IS IN POSITION
12200 BX4: CAME 14,[-1]
12300 JRST BX5
12400 JSA 16,DPYSET
12500 [3]
12600 RINP
12700 [=100]
12800 JSA 16,DPYBRT
12900 [3]
13000 BX5: MOVE 2,@1(16) ; GET R
13100 JSA 16,RHORZ
13200 2
13300 FMPR SIZ
13400 KIFIX 0,0
13500 SUB SIZ+1
13600 MOVM 2,
13700 CAILE 2,=550
13800 JRST BX6
13900 MOVEM 0,ALZ#
14000 JSA 16,SETPOG
14100 [3]
14200 JSA 16,ALINE
14300 JUMP ALZ
14400 [-=511]
14500 JUMP ALZ
14600 [=511]
14700 JSA 16,DPYOUT
14800 [3]
14900 BX6: JSA 16,SETPOG
15000 [1]
15100 JRA 16,2(16)
15200
15300
20500 DPYDO: 0 ;CALL DPYDO(N)
20600
20700 MOVE 0,@(16)
20800 MOVEM 0,ALZ
20900 CAIN 0,1 ;DON'T CLEAR IF NOT PIECE OF GLASS #1
21000 MOVNI 2,1 ; **
21100 GETLIN 2 ;0=IT IS A DD **
21200 TLNE 2,20000 ; 0=IS DD **
21300 JSA 16,DDCLR ; GO CLEAR THE DD SCREEN
21400 JSA 16,DPYOUT
21500 JUMP ALZ
21600 JRA 16,1(16) ; RETURN
21700 END